home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-26  |  14.0 KB  |  462 lines
  1. (*===========================================================================*)
  2. (* Copy a file                                                               *)
  3. (*   Handles commands and subroutines                                        *)
  4. (*                                                                           *)
  5. (*   Copyright 1988, 1989, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. UNIT BBCOPY;
  12.  
  13. INTERFACE
  14.  
  15. USES
  16.   DOS,
  17.   bbbug,
  18.   bbdummy,
  19.   bbmdata,
  20.   bbmess,
  21.   bbmisc5,
  22.   bbsdata,
  23.   bbsema2,
  24.   bbstr,
  25.   bbtask,
  26.   match;
  27.  
  28. PROCEDURE oper_cf(cmd_in : str_ptr);
  29.  
  30. FUNCTION  copy_file_binary(from_f : file_name_str; to_f : file_name_str;
  31.                                     overwrite_output : BOOLEAN) : STRING;
  32.  
  33. FUNCTION  copy_file_ascii (from_f : file_name_str; to_f : file_name_str;
  34.                                     overwrite_output : BOOLEAN) : STRING;
  35.  
  36. IMPLEMENTATION
  37.  
  38. (*===========================================================================*)
  39. (* Copy a file -- The command version                                        *)
  40. (*===========================================================================*)
  41.  
  42. PROCEDURE oper_cf(cmd_in : str_ptr);
  43.  
  44.   VAR
  45.     cmd_string : STRING;
  46.     from_f     : file_name_str;
  47.     to_f       : file_name_str;
  48.     word_count : BYTE;
  49.  
  50.   BEGIN;
  51.  
  52.     cmd_string := cmd_in^;
  53.  
  54.     (*-----------------------------------------------------------------------*)
  55.     (* Ready the input string                                                *)
  56.     (*-----------------------------------------------------------------------*)
  57.  
  58.     upcase_str_var(cmd_string);
  59.  
  60.     word_count := words(cmd_string);
  61.  
  62.     (*-----------------------------------------------------------------------*)
  63.     (* Check command format                                                  *)
  64.     (*-----------------------------------------------------------------------*)
  65.  
  66.     IF words(cmd_string) <> 3 THEN
  67.       BEGIN;
  68.         IF word_count < 3 THEN
  69.           send_message(message_not_en)
  70.         ELSE
  71.           send_message(message_err_wrd);
  72.         active_tcb^.error_sw := TRUE;
  73.         EXIT;
  74.       END;
  75.  
  76.     from_f := subwordl(cmd_string, 2, SIZEOF(from_f) - 1);
  77.     to_f   := subwordl(cmd_string, 3, SIZEOF(to_f) - 1);
  78.  
  79.     IF match_str(to_f, printer_match) THEN
  80.       cmd_string := copy_file_ascii(from_f, to_f, TRUE)
  81.     ELSE
  82.       cmd_string := copy_file_binary(from_f, to_f, FALSE);
  83.  
  84.     IF cmd_string <> '' THEN
  85.       BEGIN;
  86.         send_tnc_data_str(cmd_string + cr);
  87.         active_tcb^.error_sw := TRUE;
  88.         EXIT;
  89.       END
  90.     ELSE
  91.       send_message(message_file_saved);
  92.  
  93.   END;
  94.  
  95. (*===========================================================================*)
  96. (* Copy a file -- Straight binary                                            *)
  97. (*===========================================================================*)
  98.  
  99. FUNCTION copy_file_binary(from_f : file_name_str; to_f : file_name_str;
  100.                                    overwrite_output : BOOLEAN) : STRING;
  101.  
  102.   VAR
  103.     b   : ^CHAR;
  104.     f_f : FILE;
  105.     i   : BYTE;
  106.     j   : INTEGER;
  107.     r   : WORD;
  108.     s   : LONGINT;
  109.     t   : LONGINT;
  110.     t_f : FILE;
  111.  
  112.   BEGIN;
  113.  
  114.     (*-----------------------------------------------------------------------*)
  115.     (* Get ready to open the files                                           *)
  116.     (*-----------------------------------------------------------------------*)
  117.  
  118.     ASSIGN(f_f, from_f);
  119.     ASSIGN(t_f, to_f);
  120.  
  121.     (*-----------------------------------------------------------------------*)
  122.     (* Obtain the interrupt lock                                             *)
  123.     (*-----------------------------------------------------------------------*)
  124.  
  125.     get_semaphore(semaphore_interrupts, sem_exclusive, TRUE);
  126.  
  127.     (*-----------------------------------------------------------------------*)
  128.     (* Open input.  If it fails, tell why and exit                           *)
  129.     (*-----------------------------------------------------------------------*)
  130.  
  131.     {$I-}
  132.     RESET(f_f, 1);
  133.     {$I+}
  134.  
  135.     r := IORESULT;
  136.     IF r <> 0 THEN
  137.       BEGIN;
  138.         free_semaphore(semaphore_interrupts);
  139.         copy_file_binary := dos_err_message(r);
  140.         EXIT;
  141.       END;
  142.  
  143.     (*-----------------------------------------------------------------------*)
  144.     (* Check to see if output exists                                         *)
  145.     (*-----------------------------------------------------------------------*)
  146.  
  147.     IF NOT overwrite_output THEN
  148.       BEGIN;
  149.         {$I-}
  150.         RESET(t_f, 1);
  151.         {$I+}
  152.  
  153.         r := IORESULT;
  154.         IF r = 0 THEN
  155.           BEGIN;
  156.             free_semaphore(semaphore_interrupts);
  157.             copy_file_binary := get_message(message_file_exists);
  158.             EXIT;
  159.           END;
  160.       END;
  161.  
  162.     (*-----------------------------------------------------------------------*)
  163.     (* Open output                                                           *)
  164.     (*-----------------------------------------------------------------------*)
  165.  
  166.     {$I-}
  167.     REWRITE(t_f,1);
  168.     {$I+}
  169.     r := IORESULT;
  170.  
  171.     free_semaphore(semaphore_interrupts);
  172.  
  173.     IF r <> 0 THEN
  174.       BEGIN;
  175.         CLOSE(f_f);
  176.         copy_file_binary := dos_err_message(r);
  177.         EXIT;
  178.       END;
  179.  
  180.     (*-----------------------------------------------------------------------*)
  181.     (* Use as much memory as possible to speed things up                     *)
  182.     (*-----------------------------------------------------------------------*)
  183.  
  184.     s := MAXAVAIL - 8192;
  185.  
  186.     IF s > 1024 THEN
  187.       s := s AND $FE00;
  188.  
  189.     IF s > $FE00 THEN
  190.       s := $FE00;
  191.  
  192.     GETMEM(b, s);
  193.  
  194.     (*-----------------------------------------------------------------------*)
  195.     (* Loop until done!                                                      *)
  196.     (*-----------------------------------------------------------------------*)
  197.  
  198.     i := 0;
  199.     j := 10 - (s DIV 256);
  200.  
  201.     WHILE NOT EOF(f_f) DO
  202.       BEGIN;
  203.         BLOCKREAD (f_f, b^, s, r);
  204.         BLOCKWRITE(t_f, b^, r);
  205.         IF i > j THEN
  206.           BEGIN;
  207.             i := 0;
  208.             task_switch;
  209.           END
  210.         ELSE
  211.           INC(i);
  212.       END;
  213.  
  214.     (*-----------------------------------------------------------------------*)
  215.     (* Free buffer                                                           *)
  216.     (*-----------------------------------------------------------------------*)
  217.  
  218.     FREEMEM(b, s);
  219.  
  220.     (*-----------------------------------------------------------------------*)
  221.     (* Obtain the interrupt lock                                             *)
  222.     (*-----------------------------------------------------------------------*)
  223.  
  224.     get_semaphore(semaphore_interrupts, sem_exclusive, TRUE);
  225.  
  226.     (*-----------------------------------------------------------------------*)
  227.     (* Save the size                                                         *)
  228.     (*-----------------------------------------------------------------------*)
  229.  
  230.     io_file_size := FILESIZE(t_f);
  231.  
  232.     (*-----------------------------------------------------------------------*)
  233.     (* Fix the file date/time                                                *)
  234.     (*-----------------------------------------------------------------------*)
  235.  
  236.     GETFTIME(f_f, t);
  237.     SETFTIME(t_f, t);
  238.  
  239.     (*-----------------------------------------------------------------------*)
  240.     (* Close things up                                                       *)
  241.     (*-----------------------------------------------------------------------*)
  242.  
  243.     CLOSE(f_f);
  244.     CLOSE(t_f);
  245.  
  246.     (*-----------------------------------------------------------------------*)
  247.     (* Release the interrupt lock                                            *)
  248.     (*-----------------------------------------------------------------------*)
  249.  
  250.     free_semaphore(semaphore_interrupts);
  251.  
  252.     (*-----------------------------------------------------------------------*)
  253.     (* Tell everything is AOK                                                *)
  254.     (*-----------------------------------------------------------------------*)
  255.  
  256.     copy_file_binary := '';
  257.  
  258.   END;
  259.  
  260. (*===========================================================================*)
  261. (* Copy a file -- Ascii mode                                                 *)
  262. (*===========================================================================*)
  263.  
  264. FUNCTION copy_file_ascii(from_f : file_name_str; to_f : file_name_str;
  265.                                    overwrite_output : BOOLEAN) : STRING;
  266.  
  267.   VAR
  268.     b    : STRING;
  269.     c    : LONGINT;
  270.     f_b  : ^CHAR;
  271.     f_f  : TEXT;
  272.     l    : BYTE;
  273.     m    : BYTE;
  274.     r    : WORD;
  275.     s    : LONGINT;
  276.     t    : LONGINT;
  277.     t_b  : ^CHAR;
  278.     t_f  : TEXT;
  279.  
  280.   PROCEDURE clean_up;
  281.     VAR
  282.       i : BYTE;
  283.     BEGIN;
  284.  
  285.       {$I-}
  286.       CLOSE(f_f);
  287.       i := IORESULT;
  288.       CLOSE(t_f);
  289.       i := IORESULT;
  290.       {$I+}
  291.  
  292.       FREEMEM(f_b, s);
  293.       FREEMEM(t_b, s);
  294.  
  295.       free_semaphore(semaphore_interrupts);
  296.  
  297.     END;
  298.  
  299.   BEGIN;
  300.  
  301.     (*-----------------------------------------------------------------------*)
  302.     (* Switch for printers                                                   *)
  303.     (*-----------------------------------------------------------------------*)
  304.  
  305.     IF match_str(to_f, printer_match) THEN
  306.       m := 0
  307.     ELSE
  308.       m := 10;
  309.  
  310.     (*-----------------------------------------------------------------------*)
  311.     (* Get ready to open the files                                           *)
  312.     (*-----------------------------------------------------------------------*)
  313.  
  314.     ASSIGN(f_f, from_f);
  315.     ASSIGN(t_f, to_f);
  316.  
  317.     (*-----------------------------------------------------------------------*)
  318.     (* Obtain the interrupt lock                                             *)
  319.     (*-----------------------------------------------------------------------*)
  320.  
  321.     get_semaphore(semaphore_interrupts, sem_exclusive, TRUE);
  322.  
  323.     (*-----------------------------------------------------------------------*)
  324.     (* Use as much memory as possible to speed things up                     *)
  325.     (*-----------------------------------------------------------------------*)
  326.  
  327.     s := (MAXAVAIL div 2) - 3000;
  328.  
  329.     IF s > 1024 THEN
  330.       s := s AND $FE00;
  331.  
  332.     IF s > $FE00 THEN
  333.       s := $FE00;
  334.  
  335.     GETMEM(f_b, s);
  336.     GETMEM(t_b, s);
  337.  
  338.     SETTEXTBUF(f_f, f_b^, s);
  339.     SETTEXTBUF(t_f, t_b^, s);
  340.  
  341.     (*-----------------------------------------------------------------------*)
  342.     (* Open input.  If it fails, tell why and exit                           *)
  343.     (*-----------------------------------------------------------------------*)
  344.  
  345.     {$I-}
  346.     RESET(f_f);
  347.     {$I+}
  348.  
  349.     r := IORESULT;
  350.     IF r <> 0 THEN
  351.       BEGIN;
  352.         clean_up;
  353.         copy_file_ascii := dos_err_message(r);
  354.         EXIT;
  355.       END;
  356.  
  357.     (*-----------------------------------------------------------------------*)
  358.     (* Check to see if output exists                                         *)
  359.     (*-----------------------------------------------------------------------*)
  360.  
  361.     IF NOT overwrite_output THEN
  362.       BEGIN;
  363.         {$I-}
  364.         RESET(t_f);
  365.         {$I+}
  366.  
  367.         r := IORESULT;
  368.         IF r = 0 THEN
  369.           BEGIN;
  370.             clean_up;
  371.             copy_file_ascii := get_message(message_file_exists);
  372.             EXIT;
  373.           END;
  374.  
  375.       END;
  376.  
  377.     (*-----------------------------------------------------------------------*)
  378.     (* Open output                                                           *)
  379.     (*-----------------------------------------------------------------------*)
  380.  
  381.     {$I-}
  382.     REWRITE(t_f);
  383.     {$I+}
  384.     r := IORESULT;
  385.     IF r <> 0 THEN
  386.       BEGIN;
  387.         clean_up;
  388.         copy_file_ascii := dos_err_message(r);
  389.         EXIT;
  390.       END;
  391.  
  392.     (*-----------------------------------------------------------------------*)
  393.     (* Loop until done!                                                      *)
  394.     (*-----------------------------------------------------------------------*)
  395.  
  396.     c := 0;
  397.     l := 0;
  398.  
  399.     WHILE NOT EOF(f_f) DO
  400.       BEGIN;
  401.         READ(f_f, b);
  402.         IF EOLN(f_f) THEN
  403.           BEGIN;
  404.             {$I-}
  405.             WRITELN(t_f, b);
  406.             {$I+}
  407.             c := c + LENGTH(b) + 1;
  408.             READLN(f_f, b);
  409.           END
  410.         ELSE
  411.           BEGIN;
  412.             {$I-}
  413.             WRITE(t_f, b);
  414.             {$I+}
  415.             c := c + LENGTH(b);
  416.           END;
  417.  
  418.         r := IORESULT;
  419.         IF r <> 0 THEN
  420.           BEGIN;
  421.             clean_up;
  422.             copy_file_ascii := dos_err_message(r);
  423.             EXIT;
  424.           END;
  425.  
  426.         IF l > m THEN
  427.           BEGIN;
  428.             l := 0;
  429.             task_switch;
  430.           END;
  431.  
  432.       END;
  433.  
  434.     (*-----------------------------------------------------------------------*)
  435.     (* Save the size                                                         *)
  436.     (*-----------------------------------------------------------------------*)
  437.  
  438.     io_file_size := c;
  439.  
  440.     (*-----------------------------------------------------------------------*)
  441.     (* Fix the file date/time                                                *)
  442.     (*-----------------------------------------------------------------------*)
  443.  
  444.     GETFTIME(f_f, t);
  445.     SETFTIME(t_f, t);
  446.  
  447.     (*-----------------------------------------------------------------------*)
  448.     (* Close things up                                                       *)
  449.     (*-----------------------------------------------------------------------*)
  450.  
  451.     clean_up;
  452.  
  453.     (*-----------------------------------------------------------------------*)
  454.     (* Tell everything is AOK                                                *)
  455.     (*-----------------------------------------------------------------------*)
  456.  
  457.     copy_file_ascii := '';
  458.  
  459.   END;
  460.  
  461. END.
  462.